home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / dspsrcdr.arc / DSPSRCDR.RPG < prev    next >
Encoding:
Text File  |  1991-12-04  |  8.3 KB  |  212 lines
  1.       /TITLE  Display source member  directory.  CMD(DSPSRCDIR)
  2.      F****************************************************************
  3.      F* (C) - Copyright 1988 by Shaw-Barton, Inc., Coshocton, OH 43812
  4.      F*
  5.      F* TITLE:        DSPSRCDIR2 (RPG)
  6.      F* AUTHOR:       Joseph L. Bolen
  7.      F* DATE WRITTEN: August 1988
  8.      F*
  9.      F* DESCRIPTION:  Reformats data from DSPFD TYPE(*MBRLIST).
  10.      F* CALLED BY:    DSPSRCDIR1 (CLP)
  11.      F* CALLS:        None
  12.      F*
  13.      F****************************************************************
  14.      F*           F I L E    S P E F I C A T I O N S                 *
  15.      F****************************************************************
  16.      F*
  17.      FQAFDMBRLIF  E                    DISK
  18.      FDSPSRCDRO   E             69     PRINTER
  19.      F*
  20.      E****************************************************************
  21.      E*                E --  S P E F I C A T I O N S                 *
  22.      E****************************************************************
  23.      E*
  24.      E                    FL         21 01
  25.      E                    CHK        10 01
  26.      E                    TST        10 01
  27.      E*
  28.      I****************************************************************
  29.      I*                D A T A    S T R U C T U R E S                *
  30.      I****************************************************************
  31.      I*
  32.      I            DS
  33.      I                                        1   60YYMMDD
  34.      I                                        1   20YY
  35.      I                                        3   80MMDDYY
  36.      I                                        7   80MDYY
  37.      INUMDS       DS
  38.      I                                        1  21 NUM
  39.      I                                        1   70X
  40.      I                                        8  140Y
  41.      I                                       15  210I
  42.      I*
  43.      ITOTDS       DS
  44.      I                                        1  39 TOT
  45.      I                                        1  150TOTRCD
  46.      I                                       16  300TOTBYT
  47.      I                                       31  390TOTMBR
  48.      I*
  49.      IGTDS        DS
  50.      I                                        1  39 GTOT
  51.      I                                        1  150GTRCD
  52.      I                                       16  300GTBYT
  53.      I                                       31  390GTMBR
  54.      I*
  55.      C****************************************************************
  56.      C*            C A L C --  S P E F I C A T I O N S               *
  57.      C****************************************************************
  58.      C*
  59.      C           *IN30     IFEQ '0'
  60.      C                     EXSR HSKP
  61.      C                     MOVE '1'       *IN30
  62.      C                     END
  63.      C*
  64.      C*-----> MAINLINE
  65.      C*
  66.      C                     READ QAFDMBRL                 LR
  67.      C           *INLR     DOWEQOFF
  68.      C                     MOVEA*BLANKS   FL
  69.      C                     MOVEAMLFILE    FL,1
  70.      C                     Z-ADD1         X
  71.      C           *BLANK    LOKUPFL,X                     51 FIRST BLANK
  72.      C                     MOVE '.'       FL,X
  73.      C                     ADD  1         X
  74.      C                     MOVEAMLLIB     FL,X             QUALIFY LIBRARY
  75.      C                     MOVEAFL        FILIB
  76.      C*
  77.      C           *IN31     IFEQ ON
  78.      C           MLFILE    ORNE PRVFIL
  79.      C*
  80.      C           *IN31     CASEQOFF       BREAK1
  81.      C                     END
  82.      C                     MOVE OFF       *IN31            FIRST PAGE
  83.      C                     WRITEHEADER
  84.      C                     MOVE MLFILE    PRVFIL
  85.      C*
  86.      C                     END
  87.      C*
  88.      C           *IN20     IFEQ ON                         TYPE TEST
  89.      C           MLSEU     CABNESEUCHK    POP
  90.      C                     END
  91.      C*
  92.      C                     MOVE *BLANKS   MBR
  93.      C                     MOVELMLNAME    MBR
  94.      C*
  95.      C           *IN21     IFEQ ON                         MBR TEST
  96.      C                     MOVE OFF       *IN22
  97.      C                     EXSR TEST
  98.      C           *IN22     CABEQOFF       POP              NO MATCH
  99.      C                     END
  100.      C*
  101.      C                     EXSR MOVIT
  102.      C                     WRITEDETAIL1
  103.      C           POP       TAG
  104.      C*
  105.      C                     READ QAFDMBRL                 LR
  106.      C                     END
  107.      C*
  108.      C                     EXSR BREAK1
  109.      C                     WRITETRL2
  110.      C           ENDPGM    TAG
  111.      C                     MOVE ON        *INLR
  112.      C*
  113.      C*****************************************************************
  114.      C*           S U B R O U T I N E     S E C T I O N               *
  115.      C*****************************************************************
  116.      C*-----> HSKP <-----
  117.      C*
  118.      CSR         HSKP      BEGSR
  119.      C*
  120.      C           *ENTRY    PLIST
  121.      C                     PARM           SEUCHK  4
  122.      C                     PARM           MBRCHK 10
  123.      C*
  124.      C           *LIKE     DEFN MLFILE    PRVFIL
  125.      C*
  126.      C                     MOVE *ZEROS    NUM              ZAP FIELDS
  127.      C                     MOVE *ZEROS    TOT              ZAP FIELDS
  128.      C                     MOVE *ZEROS    GTOT             ZAP FIELDS
  129.      C                     MOVE '1'       ON      1
  130.      C                     MOVE '0'       OFF     1
  131.      C                     MOVE ON        *IN31            FIRST PAGE
  132.      C*
  133.      C           SEUCHK    IFNE 'ALL  '
  134.      C           SEUCHK    ANDNE*BLANKS
  135.      C                     MOVE ON        *IN20            SEU TYPE CHECK
  136.      C                     END                                         CK
  137.      C*
  138.      C           MBRCHK    IFNE *BLANKS
  139.      C                     MOVE ON        *IN21            MBR NAME CHECK
  140.      C                     MOVEA*BLANKS   CHK
  141.      C                     MOVEAMBRCHK    CHK,1
  142.      C*-----> CHECK FOR LENGTH OF MEMBER NAME.
  143.      C                     Z-ADD1         I
  144.      C           *BLANK    LOKUPCHK,I                    52
  145.      C           *IN52     IFEQ ON
  146.      C                     SUB  1         I
  147.      C                     END
  148.      C*-----> CHECK FOR '*' - GENERIC SEARCH
  149.      C                     Z-ADD1         Y
  150.      C           '*'       LOKUPCHK,Y                    52
  151.      C           *IN52     IFEQ ON
  152.      C                     SUB  1         Y
  153.      C           Y         IFLT 1
  154.      C                     MOVE OFF       *IN21
  155.      C                     END
  156.      C                     ELSE
  157.      C                     Z-ADDI         Y
  158.      C                     END
  159.      C*
  160.      C                     END
  161.      C*
  162.      CSR                   ENDSR
  163.      C*
  164.      C*-----> TEST <-----
  165.      C*
  166.      CSR         TEST      BEGSR
  167.      C*
  168.      C           *IN52     IFEQ OFF
  169.      C           MBR       CABNEMBRCHK    ENDTST
  170.      C                     ELSE
  171.      C                     MOVEA*BLANKS   TST
  172.      C                     MOVEAMBR       TST,1
  173.      C                     DO   Y         I
  174.      C           TST,I     CABNECHK,I     ENDTST
  175.      C                     END
  176.      C                     END
  177.      C                     MOVE ON        *IN22
  178.      C           ENDTST    TAG
  179.      C*
  180.      CSR                   ENDSR
  181.      C*
  182.      C*-----> BREAK1 <-----
  183.      C*
  184.      CSR         BREAK1    BEGSR
  185.      C*
  186.      C                     WRITETRL1
  187.      C                     ADD  TOTRCD    GTRCD
  188.      C                     ADD  TOTBYT    GTBYT
  189.      C                     ADD  TOTMBR    GTMBR
  190.      C                     MOVE *ZEROS    TOT
  191.      C*
  192.      CSR                   ENDSR
  193.      C*
  194.      C*-----> MOVIT <-----
  195.      C*
  196.      CSR         MOVIT     BEGSR
  197.      C*
  198.      C                     MOVE MLCDAT    YYMMDD
  199.      C                     MOVE YY        MDYY
  200.      C                     MOVE MMDDYY    CRTDAT
  201.      C                     MOVE MLCHGD    YYMMDD
  202.      C                     MOVE YY        MDYY
  203.      C                     MOVE MMDDYY    CHGDAT
  204.      C                     MOVE MLCHGT    CHGTIM
  205.      C                     MOVELMLMTXT    TEXT
  206.      C                     ADD  MLNRCD    TOTRCD
  207.      C                     ADD  MLSIZE    TOTBYT
  208.      C                     ADD  1         TOTMBR
  209.      C*
  210.      CSR                   ENDSR
  211.      C*
  212.